### --- Test setup ---
 
if(FALSE) {
  ## Not really needed, but can be handy when writing tests
  library("RUnit")
  library("unsupervisedMicroarray")
}
 

 
### --- Test functions ---

#check if virtual classes are virtual 
test.virtuals <- function()
{
	r2dim <-new("R2DimChooser",2,2)
	checkException(new("DimChooser",2,2))
	checkException(new("SelDimChooser",2,2))
	checkException(new("MDSDimChooser",2,2))
	checkException(new("LLEDimChooser",2,2))
 	checkException(new("Reducer",r2dim))
	kgdc <- new("KGDimChooser",1,1)
	checkException(new("vPCAReducer",kgdc))
	checkException(new("EntropyDimChooser",1,1))
	
	
	
	
} 

test.missingArguments <- function(){
	checkException(new("R2DimChooser"))
}
test.invalidArguments_DimChooser <-function(){
	#testing method from virtual class DimChooser
	checkException(new("R2DimChooser",0,2))
	checkException(new("R2DimChooser",2,0))
	checkException(new("R2DimChooser",0,1))
	checkException(new("R2DimChooser",1,0))
	checkException(new("R2DimChooser",0,0))
	
}

test.invalidArguments_Reducer <-function(){
	#invalid dim chooser for PCAReducer
	r2dc <- new("R2DimChooser",1,1)
	kgdc <- new("KGDimChooser",1,1)
	
	checkException(new("PCAReducer",r2dc))
	pcar <- new("PCAReducer",kgdc,TRUE,FALSE)
	#kPCA
	checkException(new("kPCAReducer",r2dc))
	kpcar <- new("kPCAReducer",kgdc)
	#Entropy
	cdim <- new("constDimChooser",2,2)
	checkException(new("EntropySelectionReducer",kgdc))
	entr <-new("EntropySelectionReducer",cdim)
	checkException(new("EntropySelectionReducer",cdim,"xxx"))
	
}

test.chooseBestFormat <-function(){
	#KG
	kgdc <- new("KGDimChooser",1,1)
	pcar <- new("PCAReducer",kgdc,TRUE,FALSE)
	kpcar <- new("kPCAReducer",kgdc)
	out1<-chooseBest(kgdc,pcar)
	checkTrue(is(out1,"integer"))
	out2<-chooseBest(kgdc,kpcar)
	checkTrue(is(out2,"integer"))
	#bstick
	bsdc <- new("BStickDimChooser",1,1)
	pcar <- new("PCAReducer",bsdc,TRUE,FALSE)
	#fake eigenvalues
	pcar@.eigenValues <- c(1,2,3,4)
	out3 <- chooseBest(bsdc,pcar)
	checkTrue(is(out3,"integer"))
	
}

#data for tests
library(rda)
data(brain)
data(iris)
irDat <- iris[,-5]
irC <- as.numeric(iris[,5])

bx <- brain.x[,70:100]
by <- brain.y
mm<-(matrix(runif(100),ncol=5))
mmC <- c(rep(1,10),rep(2,10))
checkRscore <-function(scoreObj,inputSet){
	scoreV <- ScoreSet(scoreObj,inputSet)
	print("ScoreV: ")
	checkTrue(scoreV >=0)
	checkTrue(scoreV<=1)
	print(scoreV)
	
}

test.NInfGainScore_test <- function(){
	
	reScore <- new("NInfGainReductionScore")
	
}
reScore <- new("NInfGainReductionScore")

test.CHangeDimChooser <-function(){
	kgdc <- new("KGDimChooser",1,1)
	cdc <- new("constDimChooser",1,1)
	bsdc <- new("BStickDimChooser",1,1)
	r2dc <-new("R2DimChooser",2,2)
	pcar <-new("PCAReducer",kgdc,TRUE,FALSE)
	mdsr <- new("MDSReducer",cdc)
	
	pcar <-changeDimChooser(pcar,cdc)
	pcar <-changeDimChooser(pcar,bsdc)
	pcar <-changeDimChooser(mdsr,cdc)
	
	checkException(pcar <-changeDimChooser(pcar,r2dc) )
	checkException(pcar <-changeDimChooser(mdsr,r2dc) )
	checkException(pcar <-changeDimChooser(mdsr,bsdc) )
	
	
	warnings()
	
}

test.outSetFormat_PCA <- function() {
	
	
	
	#PCA
	kgdc <- new("KGDimChooser",1,1)
	bsdc <- new("BStickDimChooser",1,1)
	
	pcar <-new("PCAReducer",kgdc,TRUE,FALSE)
	checkTrue(is.null(getSavedSet(pcar)))
	reduced <-reduce(pcar,mm)
	checkIdentical(class(reduced),class(mm))
	checkTrue(dim(reduced)[1] == dim(mm)[1])
	checkTrue(dim(reduced)[2] <= dim(mm)[2])
	checkRscore(reScore,list(X=reduced,Y=mmC))
	red2 <-getSavedSet(pcar)
	checkIdentical(reduced,red2)
	
	pcar2 <- pcar
	red2 <-getSavedSet(pcar2)
	checkIdentical(reduced,red2)
	
	pcar2 <-changeDimChooser(pcar,kgdc)
	checkTrue(is.null(getSavedSet(pcar2)))
	checkTrue(is.null(getSavedSet(pcar)))
	
	
	
	
	pcar <-new("PCAReducer",bsdc,TRUE,FALSE)
	reduced <- reduce(pcar,mm)
	checkIdentical(class(reduced),class(mm))
	checkTrue(dim(reduced)[1] == dim(mm)[1])
	checkTrue(dim(reduced)[2] <= dim(mm)[2])
	checkRscore(reScore,list(X=reduced,Y=mmC))
	red2 <-getSavedSet(pcar)
	checkIdentical(reduced,red2)
	
	reduced <- reduce(pcar,bx)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(bx)[1])
	checkTrue(dim(reduced)[2] <= dim(bx)[2])
	checkRscore(reScore,list(X=reduced,Y=by))
	red2 <-getSavedSet(pcar)
	checkIdentical(reduced,red2)
	
	
	
	
#	velRed <- new("VelicerDimChooser",1,1)
#	pcar <-new("PCAReducer",velRed,TRUE,FALSE)
#	reduced <-reduce(pcar,irDat)
#	checkTrue(is(reduced,"matrix"))
#	checkTrue(dim(reduced)[1] == dim(irDat)[1])
#	checkTrue(dim(reduced)[2] <= dim(irDat)[2])
#	checkRscore(reScore,list(X=reduced,Y=irC))
}
test.outSetFormat_entropy <- function() {
	#entropy
	
	constDim <-new("constDimChooser",2,2)
	entr <- new("EntropySelectionReducer",constDim)
	reduced <-reduce(entr,bx,brain.y)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1]==dim(bx)[1])
	checkTrue(dim(reduced)[2] <= dim(bx)[2])
	red2 <-getSavedSet(entr)
	checkIdentical(reduced,red2)
	
	entMean <- new("MeanEntropyDimChooser",2,2)
	entr <- new("EntropySelectionReducer",entMean)
	reduced <-reduce(entr,bx,brain.y)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1]==dim(bx)[1])
	checkTrue(dim(reduced)[2] <= dim(bx)[2])
	red2 <-getSavedSet(entr)
	checkIdentical(reduced,red2)
	
}
test.outSetFormat_kPCA <- function() {
	#kPCA
	kgdc <- new("KGDimChooser",1,1)
	bsdc <- new("BStickDimChooser",1,1)
	
	print("Test1")
	kpcar <-new("kPCAReducer",kgdc)
	reduced <-reduce(kpcar,mm)
	checkIdentical(class(reduced),class(mm))
	checkTrue(dim(reduced)[1] == dim(mm)[1])
	checkTrue(dim(reduced)[2] <= dim(mm)[2])
	checkRscore(reScore,list(X=reduced,Y=mmC))
	red2 <-getSavedSet(kpcar)
	checkIdentical(reduced,red2)
	
	print("Test2")
	kpcar <-new("kPCAReducer",bsdc)
	reduced <-reduce(kpcar,mm)
	checkIdentical(class(reduced),class(mm))
	checkTrue(dim(reduced)[1] == dim(mm)[1])
	checkTrue(dim(reduced)[2] <= dim(mm)[2])
	checkRscore(reScore,list(X=reduced,Y=mmC))
	red2 <-getSavedSet(kpcar)
	checkIdentical(reduced,red2)
	
	print("Test3")
	reduced <- reduce(kpcar,bx)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(bx)[1])
	checkTrue(dim(reduced)[2] <= dim(bx)[2])
	checkRscore(reScore,list(X=reduced,Y=by))
	red2 <-getSavedSet(kpcar)
	checkIdentical(reduced,red2)
	
	
#	print("Test4")
#	velRed <- new("VelicerDimChooser",1,1)
#	kpcar <-new("kPCAReducer",velRed)
#	reduced <-reduce(kpcar,irDat)
#	checkTrue(is(reduced,"matrix"))
#	checkTrue(dim(reduced)[1] == dim(irDat)[1])
#	checkTrue(dim(reduced)[2] <= dim(irDat)[2])
#	checkRscore(reScore,list(X=reduced,Y=irC))
}
test.outSetFormat_LLE <- function() {
	#LLE
	
	r2dc <-new("R2DimChooser",2,2)
	lleR <- new("LLEReducer",r2dc)
	#Rprof("LLEProf",memory.profiling=TRUE)
	#print("funcking LLE")
	reduced <-reduce(lleR,irDat)
	#Rprof(NULL)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(irDat)[1])
	checkTrue(dim(reduced)[2] <= dim(irDat)[2])
	red2 <-getSavedSet(lleR)
	checkIdentical(reduced,red2)
	
	cdc <- new("constDimChooser",1,1)
	lleR <- new("LLEReducer",cdc)
	
}

test.outSetFormat_MDS <- function() {
	#MDS
	scree <- new("ScreeDimChooser",2,2)
	mdsR <- new("MDSReducer",scree)
	
	reduced <-reduce(mdsR,irDat)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(irDat)[1])
	checkTrue(dim(reduced)[2] <= dim(irDat)[2])
	red2 <-getSavedSet(mdsR)
	checkIdentical(reduced,red2)
	
	reduced <-reduce(mdsR,mm)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(mm)[1])
	checkTrue(dim(reduced)[2] <= dim(mm)[2])
	red2 <-getSavedSet(mdsR)
	checkIdentical(reduced,red2)
	
	reduced <-reduce(mdsR,bx)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(bx)[1])
	checkTrue(dim(reduced)[2] <= dim(bx)[2])
	red2 <-getSavedSet(mdsR)
	checkIdentical(reduced,red2)
	
	mdsR <- new("MDSReducer",scree,"manhattan")
	reduced <-reduce(mdsR,irDat)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(irDat)[1])
	checkTrue(dim(reduced)[2] <= dim(irDat)[2])
	red2 <-getSavedSet(mdsR)
	checkIdentical(reduced,red2)
	
	reduced <-reduce(mdsR,mm)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(mm)[1])
	checkTrue(dim(reduced)[2] <= dim(mm)[2])
	red2 <-getSavedSet(mdsR)
	checkIdentical(reduced,red2)
	
	reduced <-reduce(mdsR,bx)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(bx)[1])
	checkTrue(dim(reduced)[2] <= dim(bx)[2])
	red2 <-getSavedSet(mdsR)
	checkIdentical(reduced,red2)
	
	scree <- new("constDimChooser",2,2)
	mdsR <- new("MDSReducer",scree)
	
	reduced <-reduce(mdsR,irDat)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(irDat)[1])
	checkTrue(dim(reduced)[2] <= dim(irDat)[2])
	red2 <-getSavedSet(mdsR)
	checkIdentical(reduced,red2)
	
	reduced <-reduce(mdsR,mm)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(mm)[1])
	checkTrue(dim(reduced)[2] <= dim(mm)[2])
	red2 <-getSavedSet(mdsR)
	checkIdentical(reduced,red2)
	
	reduced <-reduce(mdsR,bx)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(bx)[1])
	checkTrue(dim(reduced)[2] <= dim(bx)[2])
	red2 <-getSavedSet(mdsR)
	checkIdentical(reduced,red2)
	
	mdsR <- new("MDSReducer",scree,"manhattan")
	reduced <-reduce(mdsR,irDat)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(irDat)[1])
	checkTrue(dim(reduced)[2] <= dim(irDat)[2])
	red2 <-getSavedSet(mdsR)
	checkIdentical(reduced,red2)
	
	reduced <-reduce(mdsR,mm)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(mm)[1])
	checkTrue(dim(reduced)[2] <= dim(mm)[2])
	red2 <-getSavedSet(mdsR)
	checkIdentical(reduced,red2)
	
	reduced <-reduce(mdsR,bx)
	checkTrue(is(reduced,"matrix"))
	checkTrue(dim(reduced)[1] == dim(bx)[1])
	checkTrue(dim(reduced)[2] <= dim(bx)[2])
	red2 <-getSavedSet(mdsR)
	checkIdentical(reduced,red2)
	
	
	
	
}

test.constDimChooser_classes <-function(){
	cdc <- new("constDimChooser",1,1)
	new("PCAReducer",cdc,TRUE,FALSE)
	new("kPCAReducer",cdc)
	checkTrue(is(cdc,"PCADimChooser"))
	checkTrue(is(cdc,"kPCADimChooser"))
	checkTrue(is(cdc,"DimChooser"))
	checkTrue(is(cdc,"MDSDimChooser"))
	checkTrue(is(cdc,"LLEDimChooser"))
	checkTrue(is(cdc,"EntropyDimChooser"))
	
}